home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE15 / IDAPI / Locklist / LCKLIST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-12  |  6.1 KB  |  221 lines

  1. unit Lcklist;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Menus, Grids, DbiTypes, DbiProcs, DbiErrs, DB, DBTables,
  8.   LockInfo, Buttons, StdCtrls, ExtCtrls;
  9.  
  10. const LockStr: array[0..9] of string[30] = ('Record lock (write)',
  11.                                             'Record lock (read)',
  12.                                             'Paradox Group lock',
  13.                                             'Paradox Image lock',
  14.                                             'Table open lock',
  15.                                             'Table read lock',
  16.                                             'Table write lock',
  17.                                             'Exclusive lock',
  18.                                             'Error!',
  19.                                             'Unknown lock');
  20.  
  21.       Titles: array[0..5] of string[14] = ('LOCKTYPE', 'USERNAME', 'NETSESSION',
  22.                                            'OURSESSION', 'RECORDNUM', 'COUNT');
  23.  
  24. type
  25.   TLockTypes = (lkRecordWrite, lkRecordRead, lkPdoxGroup, lkPdoxImage,
  26.                 lkOpen, lkRead, lkWrite, lkExcl, lkError, lkUnknown);
  27.  
  28.   TFrmLocks = class(TForm)
  29.     LocksList: TStringGrid;
  30.     Table1: TTable;
  31.     Panel1: TPanel;
  32.     Edit2: TEdit;
  33.     Edit3: TEdit;
  34.     Edit4: TEdit;
  35.     Edit5: TEdit;
  36.     SpeedButton1: TSpeedButton;
  37.     SpeedButton2: TSpeedButton;
  38.     CheckBox1: TCheckBox;
  39.     CheckBox2: TCheckBox;
  40.     CheckBox3: TCheckBox;
  41.     CheckBox4: TCheckBox;
  42.     CheckBox5: TCheckBox;
  43.     Panel2: TPanel;
  44.     SpeedButton3: TSpeedButton;
  45.     SpeedButton4: TSpeedButton;
  46.     ComboBox1: TComboBox;
  47.     SpeedButton5: TSpeedButton;
  48.     Edit6: TEdit;
  49.     Label1: TLabel;
  50.     SpeedButton6: TSpeedButton;
  51.     cboLockType: TComboBox;
  52.     procedure ExitApp(Sender: TObject);
  53.     procedure ShowLocksList(Sender: TObject);
  54.     procedure FormCreate(Sender: TObject);
  55.     procedure FormDestroy(Sender: TObject);
  56.     procedure SpeedButton1Click(Sender: TObject);
  57.     procedure SpeedButton2Click(Sender: TObject);
  58.     procedure CheckBox1Click(Sender: TObject);
  59.     procedure ComboBox1Change(Sender: TObject);
  60.     procedure SpeedButton5Click(Sender: TObject);
  61.     procedure SpeedButton6Click(Sender: TObject);
  62.   private
  63.     { Private declarations }
  64.     FCursor: HDbiCur;
  65.     procedure OpenLocksList;
  66.   public
  67.     { Public declarations }
  68.     LckSrch: TLocksList;
  69.     procedure SetCursor(ATable: TTable);
  70.   end;
  71.  
  72. var
  73.   FrmLocks: TFrmLocks;
  74.  
  75.  
  76. implementation
  77.  
  78. uses RLocks;
  79.  
  80. {$R *.DFM}
  81.  
  82. procedure TFrmLocks.SetCursor(ATable: TTable);
  83. begin
  84.   if ATable.State = dsInactive then
  85.     raise Exception.Create('Table must be open');
  86.   FCursor := ATable.Handle;
  87. end;
  88.  
  89. procedure TFrmLocks.OpenLocksList;
  90. var NRecs:    LongInt;
  91.     LckDesc:  LOCKDesc;
  92.     LckCur:   HDbiCur;
  93.     CellRow:  Byte;
  94.     Props:    CURProps;
  95.     UserName: string;
  96. begin
  97.   Check(DbiOpenLockList(FCursor, True, True, LckCur));
  98.   Check(DbiGetCursorProps(LckCur, Props));
  99.   Check(DbiSetProp(HDBIObj(FCursor), curXLTMODE, LongInt(xltFIELD)));
  100.   Check(DbiGetCursorProps(LckCur, Props));
  101.   try
  102.     Check(DbiGetRecordCount(LckCur, NRecs));
  103.     if NRecs > 0 then
  104.     begin
  105.       LocksList.RowCount := Succ(NRecs);
  106.       CellRow := 1;
  107.       while (DbiGetNextRecord(LckCur, dbiNOLOCK, @LckDesc, nil) = DBIERR_NONE) do
  108.         with LocksList, LckDesc do
  109.         begin
  110.           Cells[0, CellRow] := LockStr[iType];
  111.           NativeToAnsi(Table1.Locale, szUserName, Username);
  112.           Cells[1, CellRow] := UserName;
  113.           Cells[2, CellRow] := IntToStr(iNetSession);
  114.           Cells[3, CellRow] := IntToStr(iSession);
  115.           Cells[4, CellRow] := IntToStr(iRecNum);
  116.           Cells[5, CellRow] := IntToStr(iInfo);
  117.           Inc(CellRow);
  118.         end;
  119.     end;
  120.   finally
  121.     Check(DbiCloseCursor(LckCur));
  122.   end;
  123. end;
  124.  
  125. procedure TFrmLocks.ExitApp(Sender: TObject);
  126. begin
  127.   Close;
  128. end;
  129.  
  130. procedure TFrmLocks.ShowLocksList(Sender: TObject);
  131. begin
  132.   SetCursor(Table1);
  133.   OpenLocksList;
  134. end;
  135.  
  136. procedure TFrmLocks.FormCreate(Sender: TObject);
  137. var i: Byte;
  138. begin
  139.   with cboLockType do
  140.   begin
  141.     for i := 0 to 9 do
  142.       Items[i] := LockStr[i];
  143.     ItemIndex := 0;
  144.   end;
  145.   
  146.   for i := 0 to 5 do
  147.     with LocksList do
  148.     begin
  149.       Cells[i, 0] := Titles[i];
  150.       ColWidths[i]:= Canvas.TextWidth(Titles[i]);
  151.     end;
  152.     LocksList.ColWidths[0] := Canvas.TextWidth(LockStr[3]) + 5;
  153.     Session.GetTableNames('DBDEMOS', '', True, False, Combobox1.Items);
  154.     with ComboBox1 do
  155.       ItemIndex := Items.IndexOf(Table1.TableName);
  156.  
  157.     Table1.Open;
  158.     LckSrch := TLocksList.Create;
  159.     LckSrch.Table := Table1;
  160. end;
  161.  
  162. procedure TFrmLocks.FormDestroy(Sender: TObject);
  163. begin
  164.   LckSrch.free;
  165. end;
  166.  
  167. procedure TFrmLocks.SpeedButton1Click(Sender: TObject);
  168. var ld:   LOCKDesc;
  169. begin
  170.   with cboLockType do
  171.     LckSrch.SetParams(TLockType(ItemIndex), Edit2.Text, StrToInt(Edit3.Text),
  172.       StrToInt(Edit4.Text), StrToInt(Edit5.Text));
  173.   if not LckSrch.findfirst(ld) then
  174.      showmessage('Failed - no lock found')
  175.   else
  176.      showmessage('OK - found the lock!');
  177. end;
  178.  
  179. procedure TFrmLocks.SpeedButton2Click(Sender: TObject);
  180. var ld: LOCKDesc;
  181. begin
  182.   if not LckSrch.findnext(ld) then
  183.      showmessage('Failed - no lock found')
  184.   else
  185.      showmessage('OK - found the lock!');
  186. end;
  187.  
  188. procedure TFrmLocks.CheckBox1Click(Sender: TObject);
  189. var opts: TLookFor;
  190. begin
  191.   opts := LckSrch.Lookfor;
  192.   with Sender As TCheckBox do
  193.     if Checked then Include(opts, TLockInfoType(Tag))
  194.     else Exclude(opts, TLockInfoType(Tag));
  195.   LckSrch.Lookfor := opts;
  196. end;
  197.  
  198. procedure TFrmLocks.ComboBox1Change(Sender: TObject);
  199. begin
  200.   Table1.Close;
  201.   Table1.TableName := ComboBox1.Text;
  202.   Table1.Open;
  203. end;
  204.  
  205. procedure TFrmLocks.SpeedButton5Click(Sender: TObject);
  206. var UName, Msg: string;
  207. begin
  208.   UName := GetLockUser(Table1, StrToInt(Edit6.Text));
  209.  
  210.   if UName = '' then Msg := 'Record not locked'
  211.   else Msg := 'Record locked by user ' + UName;
  212.   MessageDlg(Msg, mtInformation, [mbOK], 0);
  213. end;
  214.  
  215. procedure TFrmLocks.SpeedButton6Click(Sender: TObject);
  216. begin
  217.   Form1.Show;
  218. end;
  219.  
  220. end.
  221.